home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / Ant Movie Catalog 3.5.0.2 / amc_install.exe / {app} / Scripts / StopKlatka (PL).ifs < prev    next >
Text File  |  2005-03-13  |  13KB  |  397 lines

  1. (***************************************************
  2.  
  3. Ant Movie Catalog importation script
  4. www.antp.be/software/moviecatalog/
  5.  
  6. [Infos]
  7. Authors=(c) 2003 Maciej Galkowski
  8. Title=StopKlatka (PL)
  9. Description=Movie importation script for StopKlatka
  10. Site=http://www.stopklatka.pl
  11. Language=PL
  12. Version=1.0
  13. Requires=3.5.0
  14. Comments=send bugs and reports to: m.galkowski@interia.pl Based on All Movie script|14.02.2005 Improvements made by Adma's
  15. License=This program is free software; you can redistribute it and/or modify it under the  terms of the GNU General Public License as published by the Free Software Foundation;  either version 2 of the License, or (at your option) any later version. |
  16. GetInfo=1
  17.  
  18. [Options]
  19.  
  20. ***************************************************)
  21.  
  22. program StopKlatka;
  23. var
  24.   MovieName: string;
  25.   ImageFrom: Integer;
  26.   
  27.   
  28. procedure SetOPT();
  29. begin
  30. //OPTIONS
  31. //  ImageFrom - 0 = from StopKlatka.pl
  32. //              1 = from Amazon.com
  33. //              2 = from Amazon.com, then Stopklatka.pl if not found  (default)
  34. ImageFrom := 2;
  35. //END OPTIONS
  36. end;
  37.  
  38. // simple string procedures
  39. function StringReplaceAll(S, Old, New: string): string;
  40. begin
  41.   while Pos(Old, S) > 0 do
  42.     S := StringReplace(S, Old, New);
  43.   Result := S;
  44. end;
  45. procedure CutAfter(var Str: string; Pattern: string);
  46. begin
  47.   Str := Copy(str, Pos(Pattern, Str) + Length(Pattern), Length(Str));
  48. end;
  49. procedure CutBefore(var Str: string; Pattern: string);
  50. begin
  51.   Str := Copy(Str, Pos(Pattern, Str), Length(Str));
  52. end;
  53.  
  54. // Loads and analyses page from internet (list of movies or direct hit)
  55. procedure AnalyzePage(Address: string);
  56. var
  57.   Page: TStringList;
  58. begin
  59.   Page := TStringList.Create;
  60.   Page.Text := GetPage(Address);
  61.   // movie list
  62.   if Pos('Nic nie znaleziono', Page.Text) > 0 then
  63.   begin
  64.     ShowMessage('Nic nie znaleziono');
  65.   end
  66.   else
  67.   begin
  68.     PickTreeClear;
  69.     PickTreeAdd('Wyniki szukania', '');
  70.     AddMoviesTitles(Page);
  71.     if PickTreeExec(Address) then
  72.       AnalyzeMoviePage(Address);
  73.   end;
  74. end;
  75.  
  76. // Extracts movie details from page
  77. procedure AnalyzeMoviePage(Address: string);
  78. var
  79.   Page: string;
  80.   Value: string;
  81.   Title: string;
  82. begin
  83.   Page := GetPage(Address);
  84.   
  85.   // Title
  86.   if Pos('<h2>',Page) > 0 then
  87.   begin
  88.     SetField(fieldOriginalTitle, GetStringFromHTML(Page, '<h2>', '(', ')</h2>',1));
  89.   end;
  90.   SetField(fieldTranslatedTitle, GetStringFromHTML(Page, '<h1>', '', '</h1>',1));
  91.  
  92.   // Year
  93.   SetField(fieldYear, GetStringFromHTML(Page, '>rok produkcji:', '<b>', '</tr>',1));
  94.  
  95.   // Country
  96.   Value := GetStringFromHTML(Page, '>kraj:', '<b>', '</tr>',1);
  97.   if Pos('/', Value) > 0 then
  98.   begin
  99.     Value := StringReplaceAll(Value, ' ','');
  100.   end;
  101.   SetField(fieldCountry, Value);
  102.  
  103.   // Director
  104.   SetField(fieldDirector, GetStringFromHTML(Page, '>re┐yseria:', '<b>', '</tr>',1));
  105.  
  106.   // Genre -> category
  107.   Value := GetStringFromHTML(Page, '>gatunek:', '<b>', '</tr>',1);
  108.   if Pos('/', Value) > 0 then
  109.   begin
  110.     Value := StringReplaceAll(Value, ' ','');
  111.   end;
  112.   SetField(fieldCategory, Value);
  113.   
  114.   //URL
  115.   SetField(fieldURL,Address);
  116.  
  117.   // Image
  118.   case ImageFrom of
  119.     0 :
  120.     begin
  121.       Value := GetStringFromHTML(Page, 'http://img.stopklatka.pl/film/', '', '0.jpg',1);
  122.       if Length(Value) > 0 then GetPicture(Value + '0.jpg');
  123.     end;
  124.     1:
  125.     begin
  126.        if GetStringFromHTML(Page, '<h2>', '', '</h2>',1) <> '' then
  127.           Value := AmazonImageImport(GetStringFromHTML(Page, '<h2>', '', '</h2>',1));
  128.        else
  129.           Value := AmazonImageImport(GetStringFromHTML(Page, '<h1>', '', '</h1>',1));
  130.        if Length(Value) > 0 then GetPicture(Value);
  131.     end;
  132.     2:
  133.     begin
  134.        if GetStringFromHTML(Page, '<h2>', '', '</h2>',1) <> '' then begin
  135.           Value := AmazonImageImport(GetStringFromHTML(Page, '<h2>', '', '</h2>',1));
  136.           end
  137.        else begin
  138.           Value := AmazonImageImport(GetStringFromHTML(Page, '<h1>', '', '</h1>',1));
  139.           end
  140.        if Length(Value) > 0 then begin
  141.           GetPicture(Value);
  142.        end
  143.        else begin
  144.           Value := GetStringFromHTML(Page, 'http://img.stopklatka.pl/film/', '', '0.jpg',1);
  145.           if Length(Value) > 0 then GetPicture(Value + '0.jpg');
  146.        end
  147.     end
  148.   end; //case
  149.   
  150.   // Description
  151.   Value := GetStringFromHTML(Page, '<font  size=2 class="text2">', '', '</font>',1);
  152.   if Length(Value) > 0 then SetField(fieldDescription, Value);
  153.  
  154.   // remove trailing newline from description
  155.   Value := GetField(fieldDescription);
  156.   if Copy(Value, Length(Value) - 1, 2) = #13#10 then begin
  157.     Value := Copy(Value, 0, Length(Value) - 2);
  158.     SetField(fieldDescription, Value);
  159.   end;
  160.  
  161.   // Cast -> actors
  162.   SetField(fieldActors, GetStringFromHTML(Page, '>obsada:', '<b>', '</tr>',1));
  163.  
  164.   //DisplayResults;
  165. end;
  166.  
  167. // Adds movie titles from search results to tree
  168. procedure AddMoviesTitles(ResultsPage: TStringList);
  169. var
  170.   Page: string;
  171.   MovieTitle, MovieAddress: string;
  172. begin
  173.   Page := ResultsPage.Text;
  174.   // Every movie entry begins with string "<a href="/film/film.asp?"
  175.   while Pos('<a href="/film/film.asp?', Page) > 0 do
  176.   begin
  177.     CutBefore(Page, '<a href="/film/film.asp?');
  178.     MovieAddress := 'http://www.stopklatka.pl' + GetStringFromHTML(Page, '<a', '"', '">',0);
  179.     MovieTitle := GetStringFromHTML(Page, '<a', '', ')',0);
  180.     MovieTitle := StringReplace(MovieTitle, ')', '),  ');
  181.     if Pos('<i>', MovieTitle) > 0 then
  182.     begin
  183.       MovieTitle := MovieTitle + ')';
  184.     end
  185.     else
  186.     begin
  187.       MovieTitle := GetStringFromHTML(MovieTitle, '<a', '', '(',0);
  188.     end;
  189.     HTMLRemoveTags(MovieTitle);
  190.     CutAfter(Page, '</font>');
  191.     // add movie to list
  192.     PickTreeAdd(MovieTitle, MovieAddress);
  193.   end;
  194. end;
  195.  
  196. // Extracts single movie detail (like director, genre) from page
  197. function GetStringFromHTML(Page, StartTag, CutTag, EndTag: string; RemoveTags: Integer): string;
  198. begin
  199.   Result := '';
  200.   // recognition tag - if present, extract detail from page, otherwise assume detail is not present
  201.   if Pos(StartTag, Page) > 0 then begin
  202.     CutBefore(Page, StartTag);
  203.     // optional cut tag helps finding right string in html page
  204.     if Length(CutTag) > 0 then
  205.       CutAfter(Page, CutTag);
  206.     // movie detail copied with html tags up to end string
  207.     Result := Copy(Page, 0, Pos(EndTag, Page) - 1);
  208.     // remove html tags (if needed) and decode html string
  209.     if RemoveTags > 0 then
  210.     begin
  211.       HTMLRemoveTags(Result);
  212.     end;
  213.     HTMLDecode(Result);
  214. //  ShowMessage('DEBUG: GetStringFromHTML - StartTag "'+StartTag+'", CutTag "'+CutTag+'", EndTag "'+EndTag+'", Result "'+Result+'" ___ '+Page);
  215.   end;
  216. end;
  217.  
  218. function AmazonImageImport(Title: string):string;
  219. var
  220.   AmazonPage: TStringList;
  221.   THolder, MovieName : string;
  222.   LineNr, i, CoverNum: Integer;
  223. begin
  224.   AmazonPage := TStringList.Create;
  225.   AmazonPage.Text := GetPage('http://www.amazon.com/exec/obidos/search-handle-url/index=dvd&field-title=' + StringReplace(UrlEncode(Title),'+', '%20'));
  226.   if (FindLine('Amazon.com: DVD:',AmazonPage,1) <> -1) and
  227.      (FindLine('dvd-no-image',AmazonPage,1) = -1) then
  228.     begin
  229.       LineNr := FindLine('<input type="hidden" name="asin.',AmazonPage,1);
  230.       AmazonImageImport := 'http://images.amazon.com/images/P/' + AsinParse(AmazonPage.Getstring(LineNr)) + '.01.LZZZZZZZ.jpg';
  231.       AmazonPage.Free;
  232.       break;
  233.     end
  234.    else
  235.    if FindLine('DVD Search Results: we were unable to find exact matches for your search for',AmazonPage,1) <> -1 then
  236.     begin
  237.       ShowMessage('tuu');
  238.       AmazonPage.Free;
  239.       break;
  240.     end
  241.    else
  242.     if (FindLine('Below are results for',AmazonPage,1) <> -1) OR
  243.        (FindLine('All results',AmazonPage,1) <> -1) OR
  244.        (FindLine('Most popular results for',AmazonPage,1) <> -1) then
  245.         begin
  246.         i := 1;
  247.         CoverNum := 0;
  248.         AmazonPage.Text := GetStringFromHTML(AmazonPage.Text,'<b>Sort by:</b>','','<img src="http://g-images.amazon.com/images/G/01/associates/transparent-pixel.gif" width=1 height=1 vspace="0" hspace="0">',0);
  249.         PickTreeClear;
  250.         PickTreeAdd('Ok│adki:','');
  251.         while (i <= AmazonPage.Count-1) do
  252.         begin
  253.           THolder := AmazonPage.GetString(i);
  254.           HTMLRemoveTags(THolder);
  255.           if (Pos('/exec/obidos/ASIN/',AmazonPage.GetString(i)) <> 0) and
  256.              (THolder <> '') and
  257.              (Pos('Buy new',AmazonPage.GetString(i)) = 0) and
  258.              (Pos('Used & new from',AmazonPage.GetString(i)) = 0) and
  259.              (Pos('THUMBZZZ',AmazonPage.GetString(i)) = 0) and
  260.              (Pos('dvd-no-image',AmazonPage.GetString(i-4)) = 0) then begin
  261.                 PickTreeAdd(THolder,GetToken(AmazonPage.GetString(i),'/',5));
  262.                 CoverNum := CoverNum + 1;
  263.                 end;
  264.           if (Pos('/exec/obidos/tg/detail/',AmazonPage.GetString(i)) <> 0) and
  265.              (THolder <> '') and
  266.              (Pos('Buy new',AmazonPage.GetString(i)) = 0) and
  267.              (Pos('Used & new from',AmazonPage.GetString(i)) = 0) and
  268.              (Pos('THUMBZZZ',AmazonPage.GetString(i)) = 0) and
  269.              (Pos('http://www.amazon.com',AmazonPage.GetString(i)) = 0) and
  270.              (Pos('In-store Pickup',AmazonPage.GetString(i)) = 0) and
  271.              (Pos('dvd-no-image',AmazonPage.GetString(i-4)) = 0) then begin
  272.                 PickTreeAdd(THolder,GetToken(AmazonPage.GetString(i),'/',7));
  273.                 CoverNum := CoverNum + 1;
  274.                 end;
  275.           i := i + 1;
  276.         end
  277.         //ShowMessage(FloatToStr(CoverNum));
  278.         if CoverNum > 0 then begin
  279.         if PickTreeExec(THolder) then
  280.         begin
  281.           AmazonImageImport := 'http://images.amazon.com/images/P/' + THolder + '.01.LZZZZZZZ.jpg';
  282.           AmazonPage.Free;
  283.           break;
  284.         end
  285.         end
  286.         AmazonPage.Free;
  287.         break;
  288.       end
  289.     else
  290. AmazonPage.Free;
  291. end;
  292.  
  293. function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer;
  294. var
  295.   i: Integer;
  296. begin
  297.   Result := -1;
  298.   if StartAt < 0 then
  299.     StartAt := 0;
  300.   for i := StartAt to List.Count-1 do
  301.     if Pos(Pattern, List.GetString(i)) <> 0 then
  302.     begin
  303.       Result := i;
  304.       Break;
  305.     end;
  306. end;
  307.  
  308. function GetToken(aString, SepChar: String; TokenNum: Integer):String;
  309. var
  310.    Token     : string;
  311.    StrLen    : Integer;
  312.    TNum      : Integer;
  313.    TEnd      : Integer;
  314.  
  315. begin
  316.      StrLen := Length(aString);
  317.      TNum   := 1;
  318.      TEnd   := StrLen;
  319.      while ((TNum <= TokenNum) and (TEnd <> 0)) do
  320.      begin
  321.           TEnd := Pos(SepChar,aString);
  322.           if TEnd <> 0 then
  323.           begin
  324.                Token := Copy(aString,1,TEnd-1);
  325.                Delete(aString,1,TEnd);
  326.                TNum := TNum + 1;
  327.           end
  328.           else
  329.           begin
  330.                Token := aString;
  331.           end;
  332.      end;
  333.      if TNum >= TokenNum then
  334.      begin
  335.           GetToken := Token;
  336.      end
  337.      else
  338.      begin
  339.           GetToken := '';
  340.      end;
  341. end;
  342.  
  343. function AsinParse(Line : string): string;
  344. begin
  345.   Result := GetToken(GetToken(Line,'.',2),Chr(34),1);
  346. end;
  347.  
  348. procedure RemovePronoun(var Str: string);
  349. var
  350.   i: Integer;
  351.   s: string;
  352.   c: char;
  353. begin
  354.   // remove pronouns
  355.   if (Copy(Str, 0, 2) = 'L ') or (Copy(Str, 0, 2) = 'A ') then
  356.     Str := Copy(Str, 3, Length(Str) - 2)
  357.   else if (Copy(Str, 0, 3) = 'Le ') or (Copy(Str, 0, 3) = 'La ') or (Copy(Str, 0, 3) = 'Un ') then
  358.     Str := Copy(Str, 4, Length(Str) - 3)
  359.   else if (Copy(Str, 0, 4) = 'Les ') or (Copy(Str, 0, 4) = 'Une ') or (Copy(Str, 0, 4) = 'The ') then
  360.     Str := Copy(Str, 5, Length(Str) - 4);
  361.  
  362.   Str := StringReplaceAll(Str, '_', ' ');
  363.   // remove non-letters, non-digits and non-spaces
  364.   // polish diacritics chars are allowed
  365.   s := '';
  366.   for i := 1 to Length(Str) do begin
  367.   c := StrGet(Str, i);
  368.     if ((c<'a') or (c>'z')) and
  369.        ((c<'A') or (c>'Z')) and
  370.        ((c<'0') or (c>'9')) and
  371.        (c<>' ') and (c<>'╣') and
  372.        (c<>'Ñ') and (c<>'Ω') and
  373.        (c<>'╩') and (c<>'µ') and
  374.        (c<>'╞') and (c<>'£') and
  375.        (c<>'î') and (c<>'┐') and
  376.        (c<>'»') and (c<>'ƒ') and
  377.        (c<>'Å') and (c<>'≤') and
  378.        (c<>'╙') and (c<>'│') and
  379.        (c<>'ú') and (c<>'±') and
  380.        (c<>'╤') then
  381.     else
  382.       s := s + Copy(Str, i, 1);
  383.   end;
  384.   Str := s;
  385. end;
  386.  
  387. begin
  388.   if CheckVersion(3,5,0) then begin
  389.     SetOPT();
  390.     MovieName := GetField(fieldOriginalTitle);
  391.     if MovieName = '' then MovieName := GetField(fieldTranslatedTitle);
  392.     RemovePronoun(MovieName);
  393.     if Input('Stopklatka.pl Import', 'Podaj tytu│ filmu (tylko litery,cyfry i spacje):', MovieName) then
  394.       AnalyzePage('http://www.stopklatka.pl/szukaj/szukaj.asp?szukaj=' + URLEncode(MovieName) + '&kategoria=film&submit=Szukaj')
  395.   end else ShowMessage('Minimalne wymagania skryptu: wersja 3.5.0 programu Ant Movie Catalog.');
  396. end.
  397.